home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr25 / mr2_151.zip / UNQWK.CMD < prev    next >
OS/2 REXX Batch file  |  1993-06-20  |  5KB  |  153 lines
  1. /*
  2.     MR/2 - UNQWK.CMD
  3.  
  4.     Author:     Nick Knight
  5.     Created:    03/26/93
  6.     Usage:        unqwk packet.qwk
  7.     Purpose:    Unqwk.cmd will analyze the file named as a parameter.
  8.                 It will check the file for a valid archiver signiture
  9.                 and branch to an appropriate unarchiving command.  This
  10.                 file, as is, should accomodate most existing QWK packet
  11.                 archivers.    This utility is easily extensible, either
  12.                 by the original author, or by anyone with an urge to
  13.                 tinker.
  14.  
  15.     This was my first REXX program.  I'm sure it will be enhanced and
  16.     extended ... and I'm sure there are plenty of inefficiencies.  Feel
  17.     free to provide me with pointers, or just send me a copy of any
  18.     improvements/enhancements.
  19.  
  20.     The author claims no copyright to this particular REXX script.
  21.     Feel free to copy it and/or use it for other purposes.    I *would*
  22.     like to see the results of any improvements to it.
  23.  
  24.     US Mail:    Nick Knight, 1823 David Ave.,  Parma, Ohio 44134
  25.     Fidonet:    1:157/2 or 1:/157/200
  26.     Internet:    nick.knight@pcohio.com
  27.     Compuserve: 76066,1240
  28.     BBS:        Private messages on Nerd's Nook, 356-1772 or 356-1872
  29. */
  30.  
  31. /***********************************************************************/
  32. /*        A R C H I V E R     C O M M A N D     D E F I N I T I O N S       */
  33. /***********************************************************************/
  34. /*    To add support for a new unpacker, simply supply a new command
  35.     definition here.  The file name to unpack will be appended to
  36.     the end of the supplied command.  You can customize in more detail
  37.     by modifying the code directly, if need be.
  38. */
  39.  
  40. /*path = 'c:\utility\'*/
  41. path = ''
  42.  
  43. zip_command =    'pkunzip -o'
  44. arj_command =    'arj x'
  45. zoo_command =    'zoo x'
  46. lharc_command = 'lha x'
  47. lha_command =    'lh x'
  48. arc_command =    'arc x'
  49.  
  50.  
  51. /***********************************************************************/
  52. /*                    U N Q W K     F I L E N A M E                       */
  53. /***********************************************************************/
  54. /*
  55.     Returns -1 if it the file appears not to be a packed "archive".
  56.     Returns -2 if the file doesn't exist
  57.     Otherwise, the "archive_id" is returned (1 -> 6).
  58. */
  59.  
  60. parse arg filename
  61.  
  62. /*
  63.   06/10/93 - Check for long file name - copy to 'shorter' 8.3 name for packer
  64. */
  65.  
  66. flongname = length(filename) - lastpos('\',filename) - 12
  67. if flongname < 0 then do
  68.     flongname = length(filename) - pos('.',filename) - 3
  69. end
  70. if flongname > 0 then do
  71.     'copy "'filename'" MR2$TMP.QWK'
  72.     filename = 'MR2$TMP.QWK'
  73.     flongname = 1
  74. end
  75.  
  76. if stream(filename,'c','query exists') = "" then do
  77.     return -2
  78. end
  79.  
  80.     /*
  81.     Book says file is open in read/write by default.  This worried me,
  82.     although my tests proved that the file's datestamp remained unchanged.
  83.     Just to be safe, I wanted to open the file in read-only mode.
  84.     */
  85. status = stream(filename,'c','open read')           /* read only */
  86. header = charin(filename,1,16)
  87.  
  88.     /*    If it doesn't have at least 16 chars, it probably isn't real */
  89. if chars(filename) = 0 then do
  90.     status = stream(filename,'c','close')
  91.     return -1
  92. end
  93.  
  94. status = stream(filename,'c','close')       /* Close the file - Important! */
  95.  
  96. archiver_id = which_archiver(header)        /* call analyzer function, below */
  97.  
  98. select                                        /* execute the corresponding command */
  99.     when archiver_id = -1 then do
  100.         say "UNKNOWN ARCHIVE TYPE: " filename
  101.         return -1
  102.     end
  103.     when archiver_id = 1 then path || zip_command '"'||filename'"'
  104.     when archiver_id = 2 then path || arj_command filename
  105.     when archiver_id = 3 then path || zoo_command filename
  106.     when archiver_id = 4 then path || lharc_command filename
  107.     when archiver_id = 5 then path || lha_command filename
  108.     when archiver_id = 6 then path || arc_command filename
  109.     otherwise
  110. end
  111.  
  112. if RC <> 0 then return RC
  113.  
  114. idfile = "archiver.id"                      /* important for packing replies */
  115. status = lineout(idfile,archiver_id,1)        /* record unpacker id so */
  116. status = lineout(idfile)                    /* compatible packer can be used */
  117.  
  118. if flongname > 0 then
  119.     'del MR2$TMP.QWK'
  120.  
  121. return archive_id                            /* return the ID type */
  122.  
  123.  
  124. /***********************************************************************/
  125. /*                   W H I C H     A R C H I V E R                       */
  126. /***********************************************************************/
  127. /*
  128.     Returns -1 if it can't tell, otherwise it returns the archiver id
  129.     that I've assigned to the ones I know about.  Others can be easily
  130.     added.    Some of this may not be correct (lha vs lharc), but I tested
  131.     as much of it as I could.  Looks OK.
  132. */
  133.  
  134. which_archiver:
  135.  
  136. parse arg header                /* header is the first 16 bytes of file */
  137.  
  138. select
  139.     when substr(header,1,2) = "PK" then id = 1              /* PKWare */
  140.     when substr(header,1,1) = '`' && substr(header,2,1) = '\xEA' then id = 2 /* ARJ */
  141.     when substr(header,1,3) = "ZOO" then id = 3             /* ZOO */
  142.     when substr(header,3,5) = "-lh0-" then id = 4           /* LHARC */
  143.     when substr(header,3,5) = "-lh1-" then id = 4           /* LHARC */
  144.     when substr(header,3,3) = "-lh" then id = 5             /* LHA */
  145.     when c2d(substr(header,1,1)) = 26 then id = 6            /* ARC */
  146.     otherwise
  147.         id = -1             /* Archiver unknown or not an archive */
  148. end
  149.  
  150. return id
  151.  
  152.  
  153.